Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/wsres2/form1.frm

Visual Basic Form | 1995-05-07 | 21.2 KB | 752 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "WSResMon II"
   ClientHeight    =   3180
   ClientLeft      =   1350
   ClientTop       =   2565
   ClientWidth     =   6240
   Height          =   3870
   Icon            =   FORM1.FRX:0000
   Left            =   1290
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3180
   ScaleWidth      =   6240
   Top             =   1935
   Width           =   6360
   Begin PictureBox Spin1
      Height          =   255
      Index           =   2
      Left            =   3645
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   17
      Top             =   2135
      Width           =   255
   End
   Begin PictureBox Spin1
      Height          =   255
      Index           =   1
      Left            =   3645
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   18
      Top             =   1235
      Width           =   255
   End
   Begin PictureBox Spin1
      Height          =   255
      Index           =   0
      Left            =   3645
      ScaleHeight     =   225
      ScaleWidth      =   225
      TabIndex        =   19
      Top             =   735
      Width           =   255
   End
   Begin Timer Timer1
      Interval        =   5000
      Left            =   5400
      Top             =   2400
   End
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      Height          =   285
      Index           =   0
      Left            =   2640
      MaxLength       =   2
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   735
      Width           =   615
   End
   Begin CheckBox Check1
      BackColor       =   &H00C0C0C0&
      Caption         =   "S&pace On Drive:"
      Height          =   255
      Index           =   2
      Left            =   600
      TabIndex        =   5
      Top             =   1735
      Width           =   1815
   End
   Begin CheckBox Check1
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Available &Memory:"
      Height          =   255
      Index           =   1
      Left            =   600
      TabIndex        =   3
      Top             =   1235
      Width           =   1935
   End
   Begin CheckBox Check1
      BackColor       =   &H00C0C0C0&
      Caption         =   "&System Resources:"
      Height          =   255
      Index           =   0
      Left            =   600
      TabIndex        =   1
      Top             =   735
      Width           =   1935
   End
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      Height          =   285
      Index           =   2
      Left            =   2640
      MaxLength       =   4
      TabIndex        =   7
      Text            =   "0"
      Top             =   2135
      Width           =   615
   End
   Begin ComboBox Combo1
      BackColor       =   &H00C0C0C0&
      Height          =   300
      Left            =   2640
      TabIndex        =   6
      Text            =   "0"
      Top             =   1735
      Width           =   1265
   End
   Begin TextBox Text1
      BackColor       =   &H00FFFFFF&
      Height          =   285
      Index           =   1
      Left            =   2640
      MaxLength       =   4
      TabIndex        =   4
      Text            =   "Text1"
      Top             =   1235
      Width           =   615
   End
   Begin CommandButton Command1
      Caption         =   "Re&boot!"
      Height          =   450
      Index           =   2
      Left            =   4400
      TabIndex        =   10
      Top             =   1800
      Width           =   1700
   End
   Begin CommandButton Command1
      Caption         =   "E&xit Windows"
      Height          =   450
      Index           =   1
      Left            =   4400
      TabIndex        =   9
      Top             =   1260
      Width           =   1700
   End
   Begin CommandButton Command1
      Caption         =   "&Restart Windows"
      Height          =   450
      Index           =   0
      Left            =   4400
      TabIndex        =   8
      Top             =   720
      Width           =   1700
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "disk"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Index           =   2
      Left            =   4800
      TabIndex        =   14
      Top             =   2880
      Width           =   285
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Label1"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Index           =   1
      Left            =   3480
      TabIndex        =   16
      Top             =   2880
      Width           =   480
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "MB"
      Height          =   195
      Index           =   2
      Left            =   3300
      TabIndex        =   13
      Top             =   2185
      Width           =   285
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "KB"
      Height          =   195
      Index           =   1
      Left            =   3300
      TabIndex        =   12
      Top             =   1285
      Width           =   255
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "%"
      Height          =   195
      Index           =   0
      Left            =   3435
      TabIndex        =   11
      Top             =   735
      Width           =   150
   End
   Begin Label Label3
      BackColor       =   &H00C0C0C0&
      BackStyle       =   0  'Transparent
      Caption         =   "&Trigger Alarm At These Levels:"
      Height          =   2205
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   3855
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   "Label1"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   8.25
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   195
      Index           =   0
      Left            =   1800
      TabIndex        =   15
      Top             =   2880
      Width           =   480
   End
   Begin Menu oMenu
      Caption         =   "&Options"
      Begin Menu oItem
         Caption         =   "&Check Levels"
         Index           =   0
         Begin Menu tInt
            Caption         =   "Once Every Second"
            Index           =   0
         End
         Begin Menu tInt
            Caption         =   "Once Every 5 Seconds"
            Index           =   1
         End
         Begin Menu tInt
            Caption         =   "Once Every 10 Seconds"
            Index           =   2
         End
         Begin Menu tInt
            Caption         =   "Once Every 30  Seconds"
            Index           =   3
         End
         Begin Menu tInt
            Caption         =   "Once Every Minute"
            Index           =   4
         End
      End
      Begin Menu oItem
         Caption         =   "&Icon Title"
         Index           =   1
         Begin Menu iTitle
            Caption         =   "Show System Resources"
            Index           =   0
         End
         Begin Menu iTitle
            Caption         =   "Show Free Memory"
            Index           =   1
         End
         Begin Menu iTitle
            Caption         =   "Show Free Disk Space"
            Index           =   2
         End
         Begin Menu iTitle
            Caption         =   "&Cycle Titles"
            Index           =   3
         End
      End
      Begin Menu oItem
         Caption         =   "&Hide WSResMon icon"
         Index           =   2
      End
      Begin Menu oItem
         Caption         =   "-"
         Index           =   3
      End
      Begin Menu oItem
         Caption         =   "&About WSResMon..."
         Index           =   4
      End
      Begin Menu oItem
         Caption         =   "-"
         Index           =   5
      End
      Begin Menu oItem
         Caption         =   "E&xit WSResMon"
         Index           =   6
      End
   End
Option Explicit
DefInt A-Z
Dim SkipSave%
Dim l$(2)
Sub Alert (Mess$)
'  * creates an Alert box with an OK button
MsgBox Mess$, 48, App.Title
End Sub
Sub Check1_Click (Index As Integer)
Dim c%
c% = Check1(Index)
Text1(Index).Enabled = c%
Spin1(Index).Enabled = c%
If Index = 2 Then Combo1.Enabled = c%
If Check1(0) + Check1(1) + Check1(2) = 0 Then
    Timer1.Enabled = False
    If Not Timer1.Enabled Then Timer1.Enabled = True
End If
End Sub
Sub Combo1_Click ()
Timer1_Timer
End Sub
Sub Command1_Click (Index As Integer)
Dim a$
Dim x%, ExitCommand%
ExitCommand% = -99
Select Case Index
Case 0   'restart
   If Confirm%("Restart Windows now?") Then ExitCommand% = &H42
Case 1   'exit
   If Confirm%("Exit Windows now?") Then ExitCommand% = &H0
Case 2   'reboot
   If Confirm%("Exit Windows and reboot your PC now?") Then ExitCommand% = &H43
End Select
If ExitCommand% = -99 Then Exit Sub
MousePointer = 11
x% = ExitWindows(ExitCommand%, 0)
End Sub
Function Confirm% (Ask$)
If MsgBox(Ask$, 52, App.Title) = 6 Then Confirm% = True
End Function
Sub Draw3dFrame (f As Form, c As Label)
'draw label size you want frame -- no autosize
'label font must be same as form font!
Const White = &HFFFFFF
Const DarkGrey = &H808080
Dim X1%, X2%, Y1%, Y2%, FrameHeight%, FrameWidth%, FrameLeft%, FrameTop%
f.DrawWidth = 1
FrameLeft% = c.Left
FrameTop% = c.Top
FrameHeight% = c.Height
FrameWidth% = c.Width
'Draw left of label
X1% = FrameLeft% - 60
X2% = FrameLeft% - 180
Y1% = FrameTop% + (f.TextHeight(c.Caption) / 2) - 60
f.ForeColor = DarkGrey
f.Line (X1%, Y1%)-(X2, Y1%)
Y1% = Y1% + 20
f.ForeColor = White
f.Line (X1%, Y1%)-(X2, Y1%)
'Draw left side
Y2% = Y1% + FrameHeight%
f.ForeColor = DarkGrey
f.Line (X2%, Y1%)-(X2%, Y2%)
X2% = X2% + 20
f.ForeColor = White
f.Line (X2%, Y1%)-(X2%, Y2%)
'draw bottom
X1% = X2%
X2% = FrameLeft% + FrameWidth%
f.ForeColor = DarkGrey
f.Line (X1%, Y2)-(X2%, Y2%)
Y2% = Y2% + 15
f.ForeColor = White
f.Line (X1%, Y2)-(X2%, Y2%)
'draw right
Y1% = FrameTop% + (f.TextHeight(c.Caption) / 2) - 60
f.Line -(X2%, Y1%)
f.ForeColor = DarkGrey
X1% = X2% - 20
f.Line (X1%, Y2% - 20)-(X1%, Y1% + 20)
'draw top to label right
X2% = FrameLeft% + f.TextWidth(c.Caption) + 60
f.Line (X1%, Y1% - 15)-(X2%, Y1% - 15)
f.ForeColor = White
f.Line (X1%, Y1%)-(X2%, Y1%)
End Sub
Sub DrawStatusLine (c As Control)
Const White = &HFFFFFF
Const DarkGrey = &H808080
Dim Top%
Top% = c.Top - 60
DrawWidth = 1
ForeColor = White
Line (0, Top%)-(Width, Top%)
ForeColor = DarkGrey
Line (0, Top% - 15)-(Width, Top% - 15)
End Sub
Sub Form_Load ()
Dim i%, a%, w&
If App.PrevInstance Then
   a% = FindPrevInstance%("WSResMon")
   If a% > 0 Then w& = ShowWindow(a%, SW_SHOWNORMAL)
   SkipSave% = True
   End
End If
Ini$ = "WSRESMON.INI"
For i% = 2 To 25
   If GetDriveType%(i%) <> 0 Then Combo1.AddItem Chr$(65 + i%) + ":"
CenterForm Me
CRLF$ = Chr$(13) + Chr$(10)
i% = Height - 860
Label1(0).Move Label3.Left - 180, i%
Label1(1).Top = i%
Label1(2).Top = i%
For i% = 0 To 2
   Check1(i) = 1
   Label2(i).Move Text1(i).Left + Text1(i).Width + 30
GetSettings
Timer1_Timer
End Sub
Sub Form_Paint ()
Draw3dFrame Me, Label3
DrawStatusLine Label1(0) 'Label5
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
If SkipSave% = False Then
    Dim x%, Y%, i%, d#, m&
    'store icon title setting
    For i% = 0 To 3
        If iTitle(i).Checked Then Y% = i%
    Next
    x% = WriteIni%("IconTitle", Str$(Y%))
    'store interval setting
    For i% = 0 To 4
        If tInt(i%).Checked Then Y% = i%
    Next
    x% = WriteIni%("Interval", Str$(Y%))
    Y% = oItem(2).Checked
    x% = WriteIni%("HideIcon", Str$(Y%))
    Y% = Val(Text1(0))
    x% = WriteIni%("ResourceLevel", Str$(Y%))
    m& = Val(Text1(1))
    x% = WriteIni%("MemoryLevel", Str$(m&))
    Y% = Combo1.ListIndex
    x% = WriteIni%("Drive", Str$(Y%))
    d# = Val(Text1(2))
    x% = WriteIni%("DiskSpaceLevel", Str$(d#))
    For Y% = 0 To 2
        x% = WriteIni%("Checkbox" + Trim$(Str$(Y%)), Str$(Check1(Y%)))
    Next
    x% = WriteIni%("Windowstate", Str$(Form1.WindowState))
    On Error GoTo 0
    'now get restored window pos
    Dim WinPlace As WindowPlacement
    WinPlace.Length = 22
    x% = GetWindowPlacement%(Form1.hWnd, WinPlace) 'get current placement
    x% = WriteIni%("PosLeft", Str$(WinPlace.rcNormalPosition.Left * Screen.TwipsPerPixelX))
    x% = WriteIni%("PosTop", Str$(WinPlace.rcNormalPosition.Top * Screen.TwipsPerPixelY))
End If
End Sub
Sub Form_Resize ()
If WindowState = 1 Then
   Timer1_Timer
   If oItem(2).Checked Then
      Dim x%
      x% = FindWindow("ThunderRTMain", 0&)
      If x% Then x% = ShowWindow(x%, 1)
      Visible = False
   End If
   Caption = "WSResMon II"
   Visible = True
End If
'Dim a$
'a$ = GetRestorePos$()
'Debug.Print a$
End Sub
Sub Form_Unload (Cancel As Integer)
End Sub
Sub GetSettings ()
On Error Resume Next
Dim s$
Dim Y%
s$ = GetIni$("ResourceLevel")
If s$ = "" Then 'no ini, so set defaults
    Left = (Screen.Width - Width) / 2
    Top = (Screen.Height - Height) / 2
    WindowState = 0
    iTitle(0).Checked = True
    Combo1.ListIndex = 0
    tInt(1).Checked = True
    Text1(0) = "20"
    Text1(1) = "100"
    Text1(2) = "1.5"
    For Y% = 0 To 2
        Check1(Y%) = 1
    Next
    Exit Sub
End If
'otherwise, read ini settings
Form1.Move Val(GetIni$("PosLeft")), Val(GetIni$("PosTop"))
Form1.WindowState = Val(GetIni$("Windowstate"))
iTitle_Click Val(GetIni$("IconTitle"))
tInt_Click Val(GetIni$("Interval"))
If Val(GetIni$("HideIcon")) Then oItem_click 2
Text1(0) = GetIni$("ResourceLevel")
Text1(1) = GetIni$("MemoryLevel")
Combo1.ListIndex = Val(GetIni$("Drive"))
Text1(2) = GetIni$("DiskSpaceLevel")
For Y% = 0 To 2
   Check1(Y%) = Val(GetIni$("Checkbox" + Trim$(Str$(Y%))))
End Sub
Sub HighLightIt (c As TextBox)
   c.SelStart = 0
   c.SelLength = Len(c.Text)
End Sub
Sub HScroll1_Change ()
'If HScroll1 > Val(Label1) Then HScroll1 = Val(Label1)
'Text1(0) = HScroll1
End Sub
Sub iTitle_Click (Index As Integer)
iTitle(0).Checked = False
iTitle(1).Checked = False
iTitle(2).Checked = False
iTitle(3).Checked = False
iTitle(Index).Checked = True
End Sub
Sub oItem_click (Index As Integer)
Dim a$, Y%
Select Case Index
Case 2 'hide icon
   oItem(Index).Checked = Not oItem(Index).Checked
Case 4   'about
   Alert "WSResMon was developed using Visual Basic 3.0 by Paul Bonner for Windows Sources Magazine." + CRLF$ + CRLF$ + "Copyright
 1994 by Paul Bonner" + CRLF$ + "All Rights Reserved"
Case 6   'Exit
   If Confirm%("Exit WSResMon now?") Then Unload Me
Case Else
End Select
End Sub
Sub PostAlarm (AlarmType%)
   Dim a$, b$
   Beep
   WindowState = 0
   Visible = True
   Select Case AlarmType%
   Case 0
      b$ = "resources have"
   Case 1
      b$ = "memory has"
   Case 2
      b$ = "disk space has"
   End Select
   a$ = "Free " + b$ + " fallen below the specified threshold."
   If AlarmType% <> 2 Then a$ = a$ + CRLF$ + CRLF$ + "You may wish to close one or more applications in order to free some resources, or to exit or restart Windows."
   a$ = a$ + CRLF$ + CRLF$ + "(The alert threshold has been lowered to the current level for this resource.)"
   Alert a$
   Text1(AlarmType%).SetFocus
End Sub
Sub SetScroll (Res%)
Dim FreeRes%, FreeRAM&, FreeDisk&
FreeRAM& = FreeMem&() / 1024
FreeDisk& = (FreeDriveSpace&(Left$(Combo1, 1)) / 1024) / 1024
FreeRes% = GetFreeRes%(GFSR_SYSTEMRESOURCES)
Dim Y%
On Error Resume Next 'traps error from entering a non-numeric character or blank value
Y% = Val(Text1(Res%))   'y% will be 0 if error occurs
If Y% = 0 Then
    Text1(Res%) = "10"
    Text1(Res%).SelLength = Len(Text1(Res%))
    Text1(Res%).SetFocus
End If
On Error GoTo 0
Select Case Res%
Case 0
   If Y% > FreeRes% Then
      SettingTooHigh "system resource", FreeRes% - 1, Res%
   End If
   Y% = Val(Text1(Res%))
   If Y% < 10 Or Y% > 70 Then
      GoTo BadVal
   Else
      Exit Sub
   End If
Case 1   'mem
   If Y% > FreeRAM& Then
      SettingTooHigh "memory", FreeRAM& - 100, Res%
   End If
Case 2   'disk
   If Y% > FreeDisk& Then
    SettingTooHigh "disk space", FreeDisk& - .1, Res%
   End If
End Select
Exit Sub
BadVal:
   Alert "Threshold value must be between 10 and 70."
   If Y% < 10 Then Text1(0) = "10"
   If Y% > 70 Then Text1(0) = "70"
   Text1(0).SetFocus
   HighLightIt Text1(0)
End Sub
Sub SettingTooHigh (Setting$, NewVal#, Res%)
      Alert "You can't set the " + Setting$ + " threshold above the current free " + Setting$ + " level."
      Text1(Res%) = NewVal#
      HighLightIt Text1(Res%)
End Sub
Sub Spin1_SpinDown (Index As Integer)
Dim Increment#
Select Case Index
Case 0
   Increment# = 5
Case 1
   Increment# = 100
Case 2
   Increment# = .1
End Select
Text1(Index) = Trim$(Str$(Val(Text1(Index) - Increment#)))
SetScroll Index
End Sub
Sub Spin1_SpinUp (Index As Integer)
Dim Increment#
Select Case Index
Case 0
   Increment# = 5
Case 1
   Increment# = 100
Case 2
   Increment# = .1
End Select
On Error Resume Next
Text1(Index) = Trim$(Str$(Val(Text1(Index) + Increment#)))
SetScroll Index
End Sub
Sub Text1_Change (Index As Integer)
If Len(Text1(Index)) < 2 Then Exit Sub
SetScroll Index
End Sub
Sub Text1_GotFocus (Index As Integer)
HighLightIt Text1(Index)
End Sub
Sub Text1_LostFocus (Index As Integer)
SetScroll Index
End Sub
Sub Timer1_Timer ()
Dim a$, FreeRAM&, FreeDisk&, FreeRes%, disp%, w$
If Check1(0) Then FreeRes% = GetFreeRes%(0) 'GetFreeSystemResources%(GFSR_SYSTEMRESOURCES)
If Check1(1) Then FreeRAM& = FreeMem&() / 1024
If Check1(2) Then FreeDisk& = (FreeDriveSpace&(Left$(Combo1, 1)) / 1000) / 1000
Static Counter%
'update resources on status line
a$ = "System Resources: "
If FreeRes% > 0 Then
    a$ = a$ & FreeRes% & "%"
    a$ = a$ & "n/a"
End If
disp% = 450
If Label1(0) <> a$ Then
   Label1(0) = a$
   Label1(1).Move Label1(0).Left + Label1(0).Width + disp%
   Label1(2).Move Label1(1).Left + Label1(1).Width + disp%
End If
'update memory on status line
a$ = "Memory: "
'a$ = "RAM: " & Format$(FreeRAM&, "###,###.0#") & " KB"
If FreeRAM& > 0 Then
    a$ = a$ & Format$(FreeRAM&, "###,###.0#") & " KB"
    a$ = a$ & "n/a"
End If
If Label1(1) <> a$ Then
   Label1(1) = a$
   Label1(2).Move Label1(1).Left + Label1(1).Width + disp%
End If
'update disk space on status line
a$ = "Disk " & Combo1 + " "
If FreeDisk& > 0 Then
    a$ = a$ & Format$(FreeDisk&, "###,###.0#") & " MB"
    a$ = a$ & "n/a"
End If
If Label1(2) <> a$ Then Label1(2) = a$
If WindowState = 1 Then
'Check resources
If FreeRes% < Val(Text1(0)) And Check1(0) Then
   PostAlarm 0
   Text1(0) = Trim$(Str$(FreeRes% - 1))
   Exit Sub
End If
'Check memory
If FreeRAM& < Val(Text1(1)) And Check1(1) Then
   PostAlarm 1
   Text1(1) = Trim$(Str$(FreeRAM& - 100))
   Exit Sub
End If
'check disk space
If FreeDisk& < Val(Text1(2)) And Check1(2) Then
   PostAlarm 2
   Text1(2) = Format$(Trim$(Str$(FreeDisk& - .1)), "##.#")
   Exit Sub
End If
l$(0) = "Sys. Res:" & FreeRes% & "%"
l$(1) = "RAM: " & Format$(FreeRAM&, "###,###") & " KB"
l$(2) = Combo1 + " " & Format$(FreeDisk&, "###,###") & " MB"
If iTitle(0).Checked Then
    disp% = 0
ElseIf iTitle(1).Checked Then 'iTitle(1).Checked Then
    disp% = 1
ElseIf iTitle(2).Checked Then
    disp% = 2
TryAgain:
    If Timer1.Enabled = False Then Exit Sub
    Counter% = Counter% + 1
    If Counter% = 3 Then Counter% = 0
    If Not Check1(Counter%) > 0 Then GoTo TryAgain
    disp% = Counter%
End If
a$ = App.Title + CRLF$ + l$(disp%)
If Visible And Caption <> a$ Then Caption = a$
End If
End Sub
Sub tInt_Click (Index As Integer)
Dim i&, Y%
For Y% = 0 To 4
   tInt(Y%).Checked = False
tInt(Index).Checked = True
Select Case Index
Case 0
   i& = 1000
Case 1
   i& = 5000
Case 2
   i& = 10000
Case 3
   i& = 30000
Case 4
   i& = 60000
End Select
Timer1.Interval = i&
End Sub